home *** CD-ROM | disk | FTP | other *** search
/ Mac Easy 2010 May / Mac Life Ubuntu.iso / casper / filesystem.squashfs / usr / share / perl / 5.10.0 / ExtUtils / MM_Win32.pm < prev    next >
Encoding:
Perl POD Document  |  2009-06-26  |  12.9 KB  |  575 lines
  1. package ExtUtils::MM_Win32;
  2.  
  3. use strict;
  4.  
  5.  
  6. =head1 NAME
  7.  
  8. ExtUtils::MM_Win32 - methods to override UN*X behaviour in ExtUtils::MakeMaker
  9.  
  10. =head1 SYNOPSIS
  11.  
  12.  use ExtUtils::MM_Win32; # Done internally by ExtUtils::MakeMaker if needed
  13.  
  14. =head1 DESCRIPTION
  15.  
  16. See ExtUtils::MM_Unix for a documentation of the methods provided
  17. there. This package overrides the implementation of these methods, not
  18. the semantics.
  19.  
  20. =cut 
  21.  
  22. use ExtUtils::MakeMaker::Config;
  23. use File::Basename;
  24. use File::Spec;
  25. use ExtUtils::MakeMaker qw( neatvalue );
  26.  
  27. use vars qw(@ISA $VERSION);
  28.  
  29. require ExtUtils::MM_Any;
  30. require ExtUtils::MM_Unix;
  31. @ISA = qw( ExtUtils::MM_Any ExtUtils::MM_Unix );
  32. $VERSION = '6.42';
  33.  
  34. $ENV{EMXSHELL} = 'sh'; # to run `commands`
  35.  
  36. my $BORLAND = 1 if $Config{'cc'} =~ /^bcc/i;
  37. my $GCC     = 1 if $Config{'cc'} =~ /^gcc/i;
  38.  
  39.  
  40. =head2 Overridden methods
  41.  
  42. =over 4
  43.  
  44. =item B<dlsyms>
  45.  
  46. =cut
  47.  
  48. sub dlsyms {
  49.     my($self,%attribs) = @_;
  50.  
  51.     my($funcs) = $attribs{DL_FUNCS} || $self->{DL_FUNCS} || {};
  52.     my($vars)  = $attribs{DL_VARS} || $self->{DL_VARS} || [];
  53.     my($funclist) = $attribs{FUNCLIST} || $self->{FUNCLIST} || [];
  54.     my($imports)  = $attribs{IMPORTS} || $self->{IMPORTS} || {};
  55.     my(@m);
  56.  
  57.     if (not $self->{SKIPHASH}{'dynamic'}) {
  58.     push(@m,"
  59. $self->{BASEEXT}.def: Makefile.PL
  60. ",
  61.      q!    $(PERLRUN) -MExtUtils::Mksymlists \\
  62.      -e "Mksymlists('NAME'=>\"!, $self->{NAME},
  63.      q!\", 'DLBASE' => '!,$self->{DLBASE},
  64.      # The above two lines quoted differently to work around
  65.      # a bug in the 4DOS/4NT command line interpreter.  The visible
  66.      # result of the bug was files named q('extension_name',) *with the
  67.      # single quotes and the comma* in the extension build directories.
  68.      q!', 'DL_FUNCS' => !,neatvalue($funcs),
  69.      q!, 'FUNCLIST' => !,neatvalue($funclist),
  70.      q!, 'IMPORTS' => !,neatvalue($imports),
  71.      q!, 'DL_VARS' => !, neatvalue($vars), q!);"
  72. !);
  73.     }
  74.     join('',@m);
  75. }
  76.  
  77. =item replace_manpage_separator
  78.  
  79. Changes the path separator with .
  80.  
  81. =cut
  82.  
  83. sub replace_manpage_separator {
  84.     my($self,$man) = @_;
  85.     $man =~ s,/+,.,g;
  86.     $man;
  87. }
  88.  
  89.  
  90. =item B<maybe_command>
  91.  
  92. Since Windows has nothing as simple as an executable bit, we check the
  93. file extension.
  94.  
  95. The PATHEXT env variable will be used to get a list of extensions that
  96. might indicate a command, otherwise .com, .exe, .bat and .cmd will be
  97. used by default.
  98.  
  99. =cut
  100.  
  101. sub maybe_command {
  102.     my($self,$file) = @_;
  103.     my @e = exists($ENV{'PATHEXT'})
  104.           ? split(/;/, $ENV{PATHEXT})
  105.       : qw(.com .exe .bat .cmd);
  106.     my $e = '';
  107.     for (@e) { $e .= "\Q$_\E|" }
  108.     chop $e;
  109.     # see if file ends in one of the known extensions
  110.     if ($file =~ /($e)$/i) {
  111.     return $file if -e $file;
  112.     }
  113.     else {
  114.     for (@e) {
  115.         return "$file$_" if -e "$file$_";
  116.     }
  117.     }
  118.     return;
  119. }
  120.  
  121.  
  122. =item B<init_DIRFILESEP>
  123.  
  124. Using \ for Windows.
  125.  
  126. =cut
  127.  
  128. sub init_DIRFILESEP {
  129.     my($self) = shift;
  130.  
  131.     my $make = $self->make;
  132.  
  133.     # The ^ makes sure its not interpreted as an escape in nmake
  134.     $self->{DIRFILESEP} = $make eq 'nmake' ? '^\\' :
  135.                           $make eq 'dmake' ? '\\\\'
  136.                                            : '\\';
  137. }
  138.  
  139. =item B<init_others>
  140.  
  141. Override some of the Unix specific commands with portable
  142. ExtUtils::Command ones.
  143.  
  144. Also provide defaults for LD and AR in case the %Config values aren't
  145. set.
  146.  
  147. LDLOADLIBS's default is changed to $Config{libs}.
  148.  
  149. Adjustments are made for Borland's quirks needing -L to come first.
  150.  
  151. =cut
  152.  
  153. sub init_others {
  154.     my ($self) = @_;
  155.  
  156.     # Used in favor of echo because echo won't strip quotes. :(
  157.     $self->{ECHO}     ||= $self->oneliner('print qq{@ARGV}', ['-l']);
  158.     $self->{ECHO_N}   ||= $self->oneliner('print qq{@ARGV}');
  159.  
  160.     $self->{TOUCH}    ||= '$(ABSPERLRUN) -MExtUtils::Command -e touch';
  161.     $self->{CHMOD}    ||= '$(ABSPERLRUN) -MExtUtils::Command -e chmod'; 
  162.     $self->{CP}       ||= '$(ABSPERLRUN) -MExtUtils::Command -e cp';
  163.     $self->{RM_F}     ||= '$(ABSPERLRUN) -MExtUtils::Command -e rm_f';
  164.     $self->{RM_RF}    ||= '$(ABSPERLRUN) -MExtUtils::Command -e rm_rf';
  165.     $self->{MV}       ||= '$(ABSPERLRUN) -MExtUtils::Command -e mv';
  166.     $self->{NOOP}     ||= 'rem';
  167.     $self->{TEST_F}   ||= '$(ABSPERLRUN) -MExtUtils::Command -e test_f';
  168.     $self->{DEV_NULL} ||= '> NUL';
  169.  
  170.     $self->{FIXIN}    ||= $self->{PERL_CORE} ? 
  171.       "\$(PERLRUN) $self->{PERL_SRC}/win32/bin/pl2bat.pl" : 
  172.       'pl2bat.bat';
  173.  
  174.     $self->{LD}     ||= $Config{ld} || 'link';
  175.     $self->{AR}     ||= $Config{ar} || 'lib';
  176.  
  177.     $self->SUPER::init_others;
  178.  
  179.     # Setting SHELL from $Config{sh} can break dmake.  Its ok without it.
  180.     delete $self->{SHELL};
  181.  
  182.     $self->{LDLOADLIBS} ||= $Config{libs};
  183.     # -Lfoo must come first for Borland, so we put it in LDDLFLAGS
  184.     if ($BORLAND) {
  185.         my $libs = $self->{LDLOADLIBS};
  186.         my $libpath = '';
  187.         while ($libs =~ s/(?:^|\s)(("?)-L.+?\2)(?:\s|$)/ /) {
  188.             $libpath .= ' ' if length $libpath;
  189.             $libpath .= $1;
  190.         }
  191.         $self->{LDLOADLIBS} = $libs;
  192.         $self->{LDDLFLAGS} ||= $Config{lddlflags};
  193.         $self->{LDDLFLAGS} .= " $libpath";
  194.     }
  195.  
  196.     return 1;
  197. }
  198.  
  199.  
  200. =item init_platform
  201.  
  202. Add MM_Win32_VERSION.
  203.  
  204. =item platform_constants
  205.  
  206. =cut
  207.  
  208. sub init_platform {
  209.     my($self) = shift;
  210.  
  211.     $self->{MM_Win32_VERSION} = $VERSION;
  212. }
  213.  
  214. sub platform_constants {
  215.     my($self) = shift;
  216.     my $make_frag = '';
  217.  
  218.     foreach my $macro (qw(MM_Win32_VERSION))
  219.     {
  220.         next unless defined $self->{$macro};
  221.         $make_frag .= "$macro = $self->{$macro}\n";
  222.     }
  223.  
  224.     return $make_frag;
  225. }
  226.  
  227.  
  228. =item special_targets
  229.  
  230. Add .USESHELL target for dmake.
  231.  
  232. =cut
  233.  
  234. sub special_targets {
  235.     my($self) = @_;
  236.  
  237.     my $make_frag = $self->SUPER::special_targets;
  238.  
  239.     $make_frag .= <<'MAKE_FRAG' if $self->make eq 'dmake';
  240. .USESHELL :
  241. MAKE_FRAG
  242.  
  243.     return $make_frag;
  244. }
  245.  
  246.  
  247. =item static_lib
  248.  
  249. Changes how to run the linker.
  250.  
  251. The rest is duplicate code from MM_Unix.  Should move the linker code
  252. to its own method.
  253.  
  254. =cut
  255.  
  256. sub static_lib {
  257.     my($self) = @_;
  258.     return '' unless $self->has_link_code;
  259.  
  260.     my(@m);
  261.     push(@m, <<'END');
  262. $(INST_STATIC): $(OBJECT) $(MYEXTLIB) $(INST_ARCHAUTODIR)$(DFSEP).exists
  263.     $(RM_RF) $@
  264. END
  265.  
  266.     # If this extension has its own library (eg SDBM_File)
  267.     # then copy that to $(INST_STATIC) and add $(OBJECT) into it.
  268.     push @m, <<'MAKE_FRAG' if $self->{MYEXTLIB};
  269.     $(CP) $(MYEXTLIB) $@
  270. MAKE_FRAG
  271.  
  272.     push @m,
  273. q{    $(AR) }.($BORLAND ? '$@ $(OBJECT:^"+")'
  274.               : ($GCC ? '-ru $@ $(OBJECT)'
  275.                       : '-out:$@ $(OBJECT)')).q{
  276.     $(CHMOD) $(PERM_RWX) $@
  277.     $(NOECHO) $(ECHO) "$(EXTRALIBS)" > $(INST_ARCHAUTODIR)\extralibs.ld
  278. };
  279.  
  280.     # Old mechanism - still available:
  281.     push @m, <<'MAKE_FRAG' if $self->{PERL_SRC} && $self->{EXTRALIBS};
  282.     $(NOECHO) $(ECHO) "$(EXTRALIBS)" >> $(PERL_SRC)\ext.libs
  283. MAKE_FRAG
  284.  
  285.     join('', @m);
  286. }
  287.  
  288.  
  289. =item dynamic_lib
  290.  
  291. Complicated stuff for Win32 that I don't understand. :(
  292.  
  293. =cut
  294.  
  295. sub dynamic_lib {
  296.     my($self, %attribs) = @_;
  297.     return '' unless $self->needs_linking(); #might be because of a subdir
  298.  
  299.     return '' unless $self->has_link_code;
  300.  
  301.     my($otherldflags) = $attribs{OTHERLDFLAGS} || ($BORLAND ? 'c0d32.obj': '');
  302.     my($inst_dynamic_dep) = $attribs{INST_DYNAMIC_DEP} || "";
  303.     my($ldfrom) = '$(LDFROM)';
  304.     my(@m);
  305.  
  306. # one thing for GCC/Mingw32:
  307. # we try to overcome non-relocateable-DLL problems by generating
  308. #    a (hopefully unique) image-base from the dll's name
  309. # -- BKS, 10-19-1999
  310.     if ($GCC) { 
  311.     my $dllname = $self->{BASEEXT} . "." . $self->{DLEXT};
  312.     $dllname =~ /(....)(.{0,4})/;
  313.     my $baseaddr = unpack("n", $1 ^ $2);
  314.     $otherldflags .= sprintf("-Wl,--image-base,0x%x0000 ", $baseaddr);
  315.     }
  316.  
  317.     push(@m,'
  318. # This section creates the dynamically loadable $(INST_DYNAMIC)
  319. # from $(OBJECT) and possibly $(MYEXTLIB).
  320. OTHERLDFLAGS = '.$otherldflags.'
  321. INST_DYNAMIC_DEP = '.$inst_dynamic_dep.'
  322.  
  323. $(INST_DYNAMIC): $(OBJECT) $(MYEXTLIB) $(BOOTSTRAP) $(INST_ARCHAUTODIR)$(DFSEP).exists $(EXPORT_LIST) $(PERL_ARCHIVE) $(INST_DYNAMIC_DEP)
  324. ');
  325.     if ($GCC) {
  326.       push(@m,  
  327.        q{    dlltool --def $(EXPORT_LIST) --output-exp dll.exp
  328.     $(LD) -o $@ -Wl,--base-file -Wl,dll.base $(LDDLFLAGS) }.$ldfrom.q{ $(OTHERLDFLAGS) $(MYEXTLIB) $(PERL_ARCHIVE) $(LDLOADLIBS) dll.exp
  329.     dlltool --def $(EXPORT_LIST) --base-file dll.base --output-exp dll.exp
  330.     $(LD) -o $@ $(LDDLFLAGS) }.$ldfrom.q{ $(OTHERLDFLAGS) $(MYEXTLIB) $(PERL_ARCHIVE) $(LDLOADLIBS) dll.exp });
  331.     } elsif ($BORLAND) {
  332.       push(@m,
  333.        q{    $(LD) $(LDDLFLAGS) $(OTHERLDFLAGS) }.$ldfrom.q{,$@,,}
  334.        .($self->make eq 'dmake' 
  335.                 ? q{$(PERL_ARCHIVE:s,/,\,) $(LDLOADLIBS:s,/,\,) }
  336.          .q{$(MYEXTLIB:s,/,\,),$(EXPORT_LIST:s,/,\,)}
  337.         : q{$(subst /,\,$(PERL_ARCHIVE)) $(subst /,\,$(LDLOADLIBS)) }
  338.          .q{$(subst /,\,$(MYEXTLIB)),$(subst /,\,$(EXPORT_LIST))})
  339.        .q{,$(RESFILES)});
  340.     } else {    # VC
  341.       push(@m,
  342.        q{    $(LD) -out:$@ $(LDDLFLAGS) }.$ldfrom.q{ $(OTHERLDFLAGS) }
  343.       .q{$(MYEXTLIB) $(PERL_ARCHIVE) $(LDLOADLIBS) -def:$(EXPORT_LIST)});
  344.  
  345.       # VS2005 (aka VC 8) or higher, but not for 64-bit compiler from Platform SDK
  346.       if ($Config{ivsize} == 4 && $Config{cc} eq 'cl' and $Config{ccversion} =~ /^(\d+)/ and $1 >= 14) 
  347.     {
  348.         push(@m,
  349.           q{
  350.     mt -nologo -manifest $@.manifest -outputresource:$@;2 && del $@.manifest});
  351.       }
  352.     }
  353.     push @m, '
  354.     $(CHMOD) $(PERM_RWX) $@
  355. ';
  356.  
  357.     join('',@m);
  358. }
  359.  
  360. =item extra_clean_files
  361.  
  362. Clean out some extra dll.{base,exp} files which might be generated by
  363. gcc.  Otherwise, take out all *.pdb files.
  364.  
  365. =cut
  366.  
  367. sub extra_clean_files {
  368.     my $self = shift;
  369.  
  370.     return $GCC ? (qw(dll.base dll.exp)) : ('*.pdb');
  371. }
  372.  
  373. =item init_linker
  374.  
  375. =cut
  376.  
  377. sub init_linker {
  378.     my $self = shift;
  379.  
  380.     $self->{PERL_ARCHIVE}       = "\$(PERL_INC)\\$Config{libperl}";
  381.     $self->{PERL_ARCHIVE_AFTER} = '';
  382.     $self->{EXPORT_LIST}        = '$(BASEEXT).def';
  383. }
  384.  
  385.  
  386. =item perl_script
  387.  
  388. Checks for the perl program under several common perl extensions.
  389.  
  390. =cut
  391.  
  392. sub perl_script {
  393.     my($self,$file) = @_;
  394.     return $file if -r $file && -f _;
  395.     return "$file.pl"  if -r "$file.pl" && -f _;
  396.     return "$file.plx" if -r "$file.plx" && -f _;
  397.     return "$file.bat" if -r "$file.bat" && -f _;
  398.     return;
  399. }
  400.  
  401.  
  402. =item xs_o
  403.  
  404. This target is stubbed out.  Not sure why.
  405.  
  406. =cut
  407.  
  408. sub xs_o {
  409.     return ''
  410. }
  411.  
  412.  
  413. =item pasthru
  414.  
  415. All we send is -nologo to nmake to prevent it from printing its damned
  416. banner.
  417.  
  418. =cut
  419.  
  420. sub pasthru {
  421.     my($self) = shift;
  422.     return "PASTHRU = " . ($self->make eq 'nmake' ? "-nologo" : "");
  423. }
  424.  
  425.  
  426. =item oneliner
  427.  
  428. These are based on what command.com does on Win98.  They may be wrong
  429. for other Windows shells, I don't know.
  430.  
  431. =cut
  432.  
  433. sub oneliner {
  434.     my($self, $cmd, $switches) = @_;
  435.     $switches = [] unless defined $switches;
  436.  
  437.     # Strip leading and trailing newlines
  438.     $cmd =~ s{^\n+}{};
  439.     $cmd =~ s{\n+$}{};
  440.  
  441.     $cmd = $self->quote_literal($cmd);
  442.     $cmd = $self->escape_newlines($cmd);
  443.  
  444.     $switches = join ' ', @$switches;
  445.  
  446.     return qq{\$(ABSPERLRUN) $switches -e $cmd --};
  447. }
  448.  
  449.  
  450. sub quote_literal {
  451.     my($self, $text) = @_;
  452.  
  453.     # I don't know if this is correct, but it seems to work on
  454.     # Win98's command.com
  455.     $text =~ s{"}{\\"}g;
  456.  
  457.     # dmake eats '{' inside double quotes and leaves alone { outside double
  458.     # quotes; however it transforms {{ into { either inside and outside double
  459.     # quotes.  It also translates }} into }.  The escaping below is not
  460.     # 100% correct.
  461.     if( $self->make eq 'dmake' ) {
  462.         $text =~ s/{/{{/g;
  463.         $text =~ s/}}/}}}/g;
  464.     }
  465.  
  466.     return qq{"$text"};
  467. }
  468.  
  469.  
  470. sub escape_newlines {
  471.     my($self, $text) = @_;
  472.  
  473.     # Escape newlines
  474.     $text =~ s{\n}{\\\n}g;
  475.  
  476.     return $text;
  477. }
  478.  
  479.  
  480. =item cd
  481.  
  482. dmake can handle Unix style cd'ing but nmake (at least 1.5) cannot.  It
  483. wants:
  484.  
  485.     cd dir
  486.     command
  487.     another_command
  488.     cd ..
  489.  
  490. NOTE: This only works with simple relative directories.  Throw it an absolute dir or something with .. in it and things will go wrong.
  491.  
  492. =cut
  493.  
  494. sub cd {
  495.     my($self, $dir, @cmds) = @_;
  496.  
  497.     return $self->SUPER::cd($dir, @cmds) unless $self->make eq 'nmake';
  498.  
  499.     my $cmd = join "\n\t", map "$_", @cmds;
  500.  
  501.     my $updirs = $self->catdir(map { $self->updir } $self->splitdir($dir));
  502.  
  503.     # No leading tab and no trailing newline makes for easier embedding.
  504.     my $make_frag = sprintf <<'MAKE_FRAG', $dir, $cmd, $updirs;
  505. cd %s
  506.     %s
  507.     cd %s
  508. MAKE_FRAG
  509.  
  510.     chomp $make_frag;
  511.  
  512.     return $make_frag;
  513. }
  514.  
  515.  
  516. =item max_exec_len
  517.  
  518. nmake 1.50 limits command length to 2048 characters.
  519.  
  520. =cut
  521.  
  522. sub max_exec_len {
  523.     my $self = shift;
  524.  
  525.     return $self->{_MAX_EXEC_LEN} ||= 2 * 1024;
  526. }
  527.  
  528.  
  529. =item os_flavor
  530.  
  531. Windows is Win32.
  532.  
  533. =cut
  534.  
  535. sub os_flavor {
  536.     return('Win32');
  537. }
  538.  
  539.  
  540. =item cflags
  541.  
  542. Defines the PERLDLL symbol if we are configured for static building since all
  543. code destined for the perl5xx.dll must be compiled with the PERLDLL symbol
  544. defined.
  545.  
  546. =cut
  547.  
  548. sub cflags {
  549.     my($self,$libperl)=@_;
  550.     return $self->{CFLAGS} if $self->{CFLAGS};
  551.     return '' unless $self->needs_linking();
  552.  
  553.     my $base = $self->SUPER::cflags($libperl);
  554.     foreach (split /\n/, $base) {
  555.         /^(\S*)\s*=\s*(\S*)$/ and $self->{$1} = $2;
  556.     };
  557.     $self->{CCFLAGS} .= " -DPERLDLL" if ($self->{LINKTYPE} eq 'static');
  558.  
  559.     return $self->{CFLAGS} = qq{
  560. CCFLAGS = $self->{CCFLAGS}
  561. OPTIMIZE = $self->{OPTIMIZE}
  562. PERLTYPE = $self->{PERLTYPE}
  563. };
  564.  
  565. }
  566.  
  567. 1;
  568. __END__
  569.  
  570. =back
  571.  
  572. =cut 
  573.  
  574.  
  575.